home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / EDITORS / AE170.ZIP;1 / SPLIT.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-03-02  |  10.7 KB  |  259 lines
  1. program split ;
  2.  
  3. {-----------------------------------------------------------------------------}
  4. { SPLIT -- utility to split text files into smaller chunks                    }
  5. { syntax: SPLIT <filename> [<chunksize>[k|l]]                                 }
  6. { chunksize can be given as number of bytes, kilobytes or in lines            }
  7. { file name of chunks is same as input file                                   }
  8. { file extension of chunks is '.000', '.001', '.002' etc.                     }
  9. { program tries to split at end of line (unless line longer than chunk size)  }
  10. {-----------------------------------------------------------------------------}
  11.  
  12. {$M 16348,65535,65535}
  13. {$B-}
  14. {$I-}
  15.  
  16. uses Crt,Dos ;
  17.  
  18. const Version = '1.04' ;
  19.       Date = '1 Mar 1992' ;
  20.       DefaultChunkSize = 60000 ;
  21.       BufSize = 65536 - 512 ;
  22.  
  23. type Buf = array[1..BufSize] of char ;
  24.  
  25. var InFile, OutFile : file ;
  26.     InFileName, OutFileName : PathStr ;
  27.     SizeInLines : boolean ;         { chunk size given as no. of lines? }
  28.     DiskError : word ;
  29.     ChunkSize, ChunkNr : longint ;
  30.     ChunkSizeStr : string ;         { string representation of ChunkSize }
  31.     ChunkNrStr : string[3] ;        { string representation of ChunkNr }
  32.     code : integer ;                { result of string->number conversion }
  33.     BufPtr : ^Buf ;
  34.     FileDir : DirStr ;              { directory part of InFileName }
  35.     FileName : NameStr ;            { file name part of InFileName }
  36.     FileExt : ExtStr ;              { file extension part of InFileName }
  37.     Ready : boolean ;
  38.     ChunkFull : boolean ;
  39.     Answer : char ;                 { overwrite existing output file? }
  40.     BytesRead,BytesToWrite,BytesWritten : word ;
  41.     LineCounter : longint ;
  42.     i : word ;
  43.     LF,EF : char ;
  44.  
  45. {-----------------------------------------------------------------------------}
  46. { Indicates whether a filename contains wildcard characters                   }
  47. {-----------------------------------------------------------------------------}
  48.  
  49. function Wildcarded (Name : PathStr) : boolean ;
  50.  
  51. begin
  52. Wildcarded := (Pos('*',Name) <> 0) or (Pos('?',Name) <> 0) ;
  53. end ;
  54.  
  55. {-----------------------------------------------------------------------------}
  56. { Returns True if the file <FileName> exists, False otherwise.                }
  57. {-----------------------------------------------------------------------------}
  58.  
  59. function Exists (FileName : PathStr) : boolean ;
  60.  
  61. var SR : SearchRec ;
  62.  
  63. begin
  64. FindFirst (FileName,ReadOnly + Hidden + SysFile,SR) ;
  65. Exists := (DosError = 0) and (not Wildcarded(Filename)) ;
  66. end ;
  67.  
  68. {-----------------------------------------------------------------------------}
  69. { Reads the result of the last I/O operation into the DiskError variable      }
  70. { and produces an error message if an error has occurred.                     }
  71. {-----------------------------------------------------------------------------}
  72.  
  73. procedure CheckDiskError ;
  74.  
  75. var ErrorText : string ;
  76.  
  77. begin
  78. DiskError := IOResult ;
  79. if DiskError <> 0
  80.    then begin
  81.         case DiskError of
  82.              2   : ErrorText := 'File not found' ;
  83.              3   : ErrorText := 'Path not found' ;
  84.              5   : ErrorText := 'File access denied' ;
  85.              101 : ErrorText := 'Disk write error' ;
  86.              150 : ErrorText := 'Disk is write-protected' ;
  87.              152 : ErrorText := 'Drive not ready' ;
  88.              159 : ErrorText := 'Printer out of paper' ;
  89.              160 : ErrorText := 'Device write fault' ;
  90.              else  begin
  91.                    Str (DiskError,ErrorText) ;
  92.                    ErrorText := 'I/O error ' + ErrorText ;
  93.                    end ;
  94.              end ; { of case }
  95.         Writeln ;
  96.         Writeln (ErrorText) ;
  97.         end ; { of if }
  98. end ;
  99.  
  100. {-----------------------------------------------------------------------------}
  101.  
  102. begin
  103. LF := #10 ; { line-feed character }
  104. EF := #26 ; { end-of-file-character }
  105. Writeln ('SPLIT -- utility to split text files into smaller chunks') ;
  106. Writeln ('         version ',Version,'  ',Date) ;
  107. Writeln ;
  108. if (ParamCount < 1) or (ParamCount > 2)
  109.    then begin
  110.         { wrong number of parameters: give help then quit program }
  111.         Writeln ('Usage: SPLIT <filename> [<chunksize> [k|l]]') ;
  112.         Exit ; { not nice programming but to prevent huge nesting of ifs }
  113.         end ;
  114. if ParamCount = 1
  115.    then begin
  116.         { no chunk size given: use default }
  117.         SizeInLines := false ;
  118.         ChunkSize := DefaultChunkSize ;
  119.         end
  120.    else begin
  121.         ChunkSizeStr := ParamStr(2) ;
  122.         if UpCase(ChunkSizeStr[Length(ChunkSizeStr)]) = 'L'
  123.            then begin
  124.                 { chunk size given in lines }
  125.                 SizeInLines := true ;
  126.                 Val (Copy(ChunkSizeStr,1,Length(ChunkSizeStr)-1),
  127.                      ChunkSize,code) ;
  128.                 end
  129.            else begin
  130.                 SizeInLines := false ;
  131.                 if UpCase(ChunkSizeStr[Length(ChunkSizeStr)]) = 'K'
  132.                    then begin
  133.                         { chunk size given in kilobytes }
  134.                         Val (Copy(ChunkSizeStr,1,Length(ChunkSizeStr)-1),
  135.                              ChunkSize,code) ;
  136.                         ChunkSize := ChunkSize * 1024 ;
  137.                         end
  138.                    else { chunk size given in bytes }
  139.                         Val (ChunkSizeStr,ChunkSize,code) ;
  140.                         { decrease ChunkSize by 1 to allow for EOF char }
  141.                         Dec (ChunkSize) ;
  142.                 end ;
  143.         if (code <> 0) or (ChunkSize <= 0)
  144.            then begin
  145.                 Writeln ('Invalid chunk size "',ParamStr(2),'"') ;
  146.                 Writeln ('Usage: SPLIT <filename> [<chunksize>[k|l]]') ;
  147.                 Exit ;
  148.                 end ;
  149.         end ;
  150. InFileName := FExpand (ParamStr(1)) ;
  151. if not Exists(InFileName)
  152.    then begin
  153.         Writeln ('Input file "',InFileName,'" not found') ;
  154.         Exit ;
  155.         end
  156.    else Writeln ('Splitting file "',InFileName,'"') ;
  157. Assign (InFile,InFileName) ;
  158. Reset (InFile,1) ;
  159. CheckDiskError ;
  160. { allocate memory buffer for contents of file }
  161. GetMem (BufPtr,BufSize) ;
  162. ChunkNr := 0 ;
  163. FSplit (InFileName,FileDir,FileName,FileExt) ;
  164. Ready := (DiskError <> 0) ;
  165. ChunkFull := true ;
  166. while not Ready do
  167.       begin
  168.       if ChunkFull
  169.          then begin
  170.               { start writing new chunk: }
  171.               { construct output file name }
  172.               Str (ChunkNr,ChunkNrStr) ;
  173.               while Length(ChunkNrStr) < 3 do
  174.                     ChunkNrStr := '0' + ChunkNrStr ;
  175.               OutFileName := FExpand (FileName + '.' + ChunkNrStr) ;
  176.               if Exists (OutFileName)
  177.                  then begin
  178.                       Write ('File "',OutFileName,'" already exists. ') ;
  179.                       Write ('Skip, Overwrite, Abort? (S/O/A) ') ;
  180.                       repeat Answer := UpCase(ReadKey) ;
  181.                       until Answer in ['S','O','A'] ;
  182.                       Writeln (Answer) ;
  183.                       end
  184.                  else Answer := 'O' ;
  185.               case Answer of
  186.                    'S' : { skip }
  187.                          Inc (ChunkNr) ;
  188.                    'O' : begin
  189.                          { open output file }
  190.                          Write ('File "',OutFileName,'" ... ') ;
  191.                          Assign (OutFile,OutFileName) ;
  192.                          ReWrite (OutFile,1) ;
  193.                          CheckDiskError ;
  194.                          ChunkFull := (DiskError <> 0) ;
  195.                          LineCounter := 1 ;
  196.                          end ;
  197.                    'A' : { abort }
  198.                          Ready := True ;
  199.                    end ; { of case }
  200.               end ; { of if }
  201.       if not ChunkFull
  202.          then begin
  203.               { write chunk }
  204.               repeat BlockRead (InFile,BufPtr^,BufSize,BytesRead) ;
  205.                      CheckDiskError ;
  206.                      if (BytesRead = 0) or (DiskError <> 0)
  207.                         then Ready := true
  208.                         else begin
  209.                              BytesToWrite := BytesRead ;
  210.                              { scan block and check if chunk is full }
  211.                              i := 0 ;
  212.                              repeat
  213.                                 Inc(i) ;
  214.                                 if BufPtr^[i] = LF
  215.                                    then begin
  216.                                         Inc (LineCounter) ;
  217.                                         if SizeInLines
  218.                                            then begin
  219.                                                 ChunkFull := (LineCounter >
  220.                                                               ChunkSize) ;
  221.                                                 BytesToWrite := i ;
  222.                                                 end
  223.                                            else if (FileSize(OutFile)+i) <=
  224.                                                                    ChunkSize
  225.                                                    then BytesToWrite := i
  226.                                                    else begin
  227.                                                         ChunkFull := true ;
  228.                                                         Dec (LineCounter) ;
  229.                                                         end ;
  230.                                         end ;
  231.                              until ChunkFull or (i = BytesRead) ;
  232.                              { to make sure last line is also written: }
  233.                              if (not SizeInLines) and
  234.                                 ((FileSize(OutFile)+BytesRead) < ChunkSize)
  235.                                 then BytesToWrite := BytesRead ;
  236.                              { write bytes to output file }
  237.                              BlockWrite (OutFile,BufPtr^,BytesToWrite,
  238.                                          BytesWritten) ;
  239.                              { correct current position of input file }
  240.                              Seek (InFile,FilePos(InFile)-
  241.                                           (BytesRead-BytesWritten)) ;
  242.                              if (not SizeInLines) and
  243.                                 (FileSize(OutFile) >= ChunkSize)
  244.                                 then ChunkFull := true ;
  245.                              end ;
  246.               until (ChunkFull or Ready) ;
  247.               { close output file; write end-of-file char }
  248.               if not Eof(InFile)
  249.                  then BlockWrite (OutFile,EF,1) ;
  250.               Writeln (LineCounter,' lines, ',
  251.                        FileSize(OutFile),' bytes written.') ;
  252.               Close (OutFile) ;
  253.               CheckDiskError ;
  254.               Inc (ChunkNr) ;
  255.               end ; { of if }
  256.       end ; { of while }
  257. Close (InFile) ;
  258. end.
  259.